home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok29.lha / ImageConvert / ImageConvert.modO < prev    next >
Text File  |  1993-08-15  |  9KB  |  288 lines
  1. (* ------------------------------------------------------------------------
  2.   :Program.       ImageConvert
  3.   :Author.        Kai Bolay
  4.   :Address.       Hoffmannstraße 168
  5.   :Address.       D-7250 Leonberg 1
  6.   :Phone.         (0)7152/22135
  7.   :Shortcut.      [kai]
  8.   :Version.       1.0
  9.   :Date.          25-Nov-89
  10.   :Copyright.     PD
  11.   :Language.      Modula-2
  12.   :Translator.    M2Amiga 3.2d
  13.   :Imports.       IFFSupport1.5 [fbs]
  14.   :Contents.      Umwandlung von IFF-Brushes in M2-Source-Code.
  15. ------------------------------------------------------------------------ *)
  16.  
  17. MODULE ImageConvert;
  18.  
  19. (* FOLD: IMPORT *)
  20. FROM SYSTEM     IMPORT ADR, ADDRESS;
  21. FROM Arts       IMPORT Assert, TermProcedure, Terminate, CurrentLevel;
  22. FROM Arguments  IMPORT NumArgs, GetArg;
  23. FROM Str        IMPORT Copy, Concat;
  24. FROM FileNames  IMPORT GetPath;
  25. FROM IFFSupport IMPORT ReadILBM, ReadILBMFlags, ReadILBMFlagSet, IFFInfo;
  26. FROM InOut2     IMPORT SetOutput, WriteString, WriteLn, WriteCard,
  27.                        ReadString, done, CloseOutput, WriteHex, WriteInt;
  28. FROM Graphics   IMPORT RastPortPtr, BitMapPtr;
  29. FROM Icon       IMPORT GetDiskObject, PutDiskObject, FreeDiskObject;
  30. FROM Workbench  IMPORT DiskObjectPtr;
  31. FROM Intuition  IMPORT ScreenPtr, CloseScreen, WindowPtr, DisplayBeep;
  32. (* ENDFD *)
  33.  
  34. VAR num, len         : INTEGER;
  35.     Output, Argument : ARRAY [1..200] OF CHAR;
  36.     DefOpen, ModOpen : BOOLEAN;
  37.     MyScreen         : ScreenPtr;
  38.  
  39. (* FOLD: MakeIcon *)
  40. PROCEDURE MakeIcon (name : ARRAY OF CHAR);
  41.  
  42. CONST IconName = "M2:Icons/txt";
  43.  
  44. VAR Icon : DiskObjectPtr;
  45.  
  46. BEGIN
  47.    Icon := GetDiskObject (ADR (IconName));
  48.    IF Icon # NIL THEN
  49.       IF PutDiskObject (ADR (name), Icon) = 0 THEN END;
  50.       FreeDiskObject (Icon);
  51.    END; (* IF *)
  52. END MakeIcon;
  53. (* ENDFD *)
  54. (* FOLD: WriteName *)
  55. PROCEDURE WriteName (name : ARRAY OF CHAR);
  56.  
  57. VAR path : ARRAY [0..100] OF CHAR;
  58.     len  : INTEGER;
  59.  
  60. BEGIN
  61.    GetPath (name, path, len);
  62.    WriteString (name);
  63. END WriteName;
  64. (* ENDFD *)
  65. (* FOLD: CloseDef *)
  66. PROCEDURE CloseDef;
  67.  
  68. BEGIN
  69.    IF DefOpen THEN
  70.       CloseOutput ();
  71.    END; (* IF *)
  72. END CloseDef;
  73. (* ENDFD *)
  74. (* FOLD: OpenDef *)
  75. PROCEDURE OpenDef;
  76.  
  77. VAR DefName : ARRAY [1..200] OF CHAR;
  78.  
  79. BEGIN
  80.    TermProcedure (CloseDef);
  81.    Copy (DefName, Output);
  82.    Concat (DefName, ".def");
  83.    SetOutput (DefName);
  84.    DefOpen := done;
  85.    Assert (DefOpen, ADR ("Can't open DEFINITION-File!"));
  86.    MakeIcon (DefName);
  87. END OpenDef;
  88. (* ENDFD *)
  89. (* FOLD: CloseMod *)
  90. PROCEDURE CloseMod;
  91.  
  92. BEGIN
  93.    IF ModOpen THEN
  94.       CloseOutput ();
  95.    END; (* IF *)
  96. END CloseMod;
  97. (* ENDFD *)
  98. (* FOLD: OpenMod *)
  99. PROCEDURE OpenMod;
  100.  
  101. VAR ModName : ARRAY [1..200] OF CHAR;
  102.  
  103. BEGIN
  104.    TermProcedure (CloseMod);
  105.    Copy (ModName, Output);
  106.    Concat (ModName, ".mod");
  107.    SetOutput (ModName);
  108.    ModOpen := done;
  109.    Assert (ModOpen, ADR ("Can't open IMPLEMENTATION-File!"));
  110.    MakeIcon (ModName);
  111. END OpenMod;
  112. (* ENDFD *)
  113. (* FOLD: WriteModProcs *)
  114. PROCEDURE WriteModProcs (name : ARRAY OF CHAR);
  115.  
  116. VAR Depth, Width, Height,
  117.     ByteWidth, ScrByteWidth : INTEGER;
  118.     RP                      : RastPortPtr;
  119.     BM                      : BitMapPtr;
  120.     Plane, Line, Step       : INTEGER;
  121.     MyWindow                : WindowPtr;
  122.     NewLine                 : BOOLEAN;
  123.     Location                : POINTER TO CARDINAL;
  124.     Num                     : CARDINAL;
  125.  
  126. BEGIN
  127.    IF NOT (ReadILBM (name, ReadILBMFlagSet {visible}, MyScreen, MyWindow)) THEN
  128.       DisplayBeep (NIL);
  129.    ELSE
  130.       WITH IFFInfo.BMHD DO
  131.          Depth  := depth;
  132.          Width  := width;
  133.          Height := height;
  134.       END; (* WITH *)
  135.       ByteWidth := Width DIV 8;
  136.       IF (ByteWidth * 8) < Width THEN
  137.          INC (ByteWidth);
  138.       END; (* IF *)
  139.       IF ODD (ByteWidth) THEN
  140.          INC (ByteWidth);
  141.       END; (* IF *)
  142.       WITH MyScreen^ DO
  143.          ScrByteWidth := width DIV 8;
  144.          RP := ADR (rastPort);
  145.          BM := RP^.bitMap;
  146.       END; (* WITH *)
  147.  
  148.       WriteLn;
  149.       WriteString ("(* $E- *)"); WriteLn;
  150.       WriteString ("PROCEDURE "); WriteName (name); WriteString ("Dat;");
  151.       WriteLn; WriteLn;
  152.       WriteString ("BEGIN"); WriteLn;
  153.       FOR Plane := 0 TO Depth-1 DO
  154.          WriteString ("   (* Plane "); WriteInt (Plane+1, 1);
  155.          WriteString (" *)"); WriteLn;
  156.          NewLine := TRUE;
  157.          FOR Line := 0 TO Height-1 DO
  158.             FOR Step := 0 TO ByteWidth-2 BY 2 DO
  159.                IF NewLine THEN
  160.                   WriteString ("   INLINE (");
  161.                   NewLine := FALSE;
  162.                   Num := 0;
  163.                END; (* IF *)
  164.                WriteString ("0");
  165.                Location := ADDRESS (BM^.planes[Plane] + Step +
  166.                                     ScrByteWidth * Line);
  167.                WriteHex (Location^, 4); (* Hex-Wert schreiben *)
  168.                WriteString ("H");
  169.                INC (Num);
  170.                IF (Num = 8) OR
  171.                   ((Step = ByteWidth-2) AND (Line = Height-1)) THEN
  172.                   WriteString (");"); WriteLn;
  173.                   NewLine := TRUE;
  174.                ELSE
  175.                   WriteString (", ");
  176.                END; (* IF *)
  177.             END; (* FOR Step *)
  178.          END; (* FOR Line *)
  179.       END; (* FOR Plane *)
  180.       WriteString ("END "); WriteName (name); WriteString ("Dat;"); WriteLn;
  181.       WriteLn; WriteLn;
  182.       CloseScreen (MyScreen); MyScreen := NIL;
  183.       WriteString ("PROCEDURE Init"); WriteName (name); WriteString (";");
  184.       WriteLn; WriteLn;
  185. (*** if less than v3.3 ***)
  186.       WriteString ("CONST "); WriteName (name); WriteString ("Size =");
  187.       WriteInt (Height * ByteWidth * Depth, 5); WriteString (";");
  188.       WriteLn; WriteLn;
  189. (*** endif ***)
  190.       WriteString ("BEGIN"); WriteLn;
  191.       WriteString ("   WITH "); WriteName (name); WriteString (" DO");
  192.       WriteLn;
  193.       WriteString ("      leftEdge   := 0;"); WriteLn;
  194.       WriteString ("      topEdge    := 0;"); WriteLn;
  195.       WriteString ("      width      := "); WriteInt (Width, 3);
  196.       WriteString (";"); WriteLn;
  197.       WriteString ("      height     := "); WriteInt (Height, 3);
  198.       WriteString (";"); WriteLn;
  199.       WriteString ("      depth      := "); WriteInt (Depth, 1);
  200.       WriteString (";"); WriteLn;
  201. (*** if Compiler v3.3 ***
  202.       WriteString ("      imageData  := ADR ("); WriteName (name);
  203.       WriteString ("Dat);"); WriteLn;
  204.  *** endif ***)
  205.       WriteString ("      planePick  := 255;"); WriteLn;
  206.       WriteString ("      planeOnOff := 0;"); WriteLn;
  207.       WriteString ("      nextImage  := NIL;"); WriteLn;
  208. (*** if less than v3.3 ***)
  209.       WriteString ("      AllocMem (imageData, "); WriteName (name);
  210.       WriteString ("Size, TRUE);"); WriteLn;
  211.       WriteString ("      CopyMem (ADR ("); WriteName (name);
  212.       WriteString ("Dat), imageData, "); WriteName (name);
  213.       WriteString ("Size);"); WriteLn;
  214. (*** endif ***)
  215.       WriteString ("   END; (* WITH *)"); WriteLn;
  216.       WriteString ("END Init"); WriteName (name); WriteString (";");
  217.       WriteLn;
  218.    END; (* IF *)
  219. END WriteModProcs;
  220. (* ENDFD *)
  221. (* FOLD: CleanUp *)
  222. PROCEDURE CleanUp;
  223.  
  224. BEGIN
  225.    IF MyScreen # NIL THEN
  226.       CloseScreen (MyScreen);
  227.       MyScreen := NIL;
  228.    END; (* IF *)
  229. END CleanUp;
  230. (* ENDFD *)
  231.  
  232. BEGIN
  233.    TermProcedure (CleanUp);
  234.    WriteString ("Image Convert 1.0.  © 1989 by Kai Bolay"); WriteLn;
  235.    WriteLn;
  236.    IF NumArgs() = 0 THEN
  237.       WriteString ("No Input!"); WriteLn;
  238.       Terminate (CurrentLevel());
  239.    END; (* IF *)
  240.    WriteString ("Name of Module to be generated (without Extension):"); WriteLn;
  241.    ReadString (Output);
  242.    (* FOLD: DEFINITION *)
  243.    OpenDef;
  244.    WriteString ("DEFINITION MODULE ");
  245.    WriteName (Output); WriteString (";"); WriteLn;
  246.    WriteLn;
  247.    WriteString ("FROM Intuition IMPORT Image;"); WriteLn; WriteLn;
  248.    FOR num := 1 TO NumArgs() DO
  249.       GetArg (num, Argument, len);
  250.       IF num = 1 THEN
  251.          WriteString ("VAR ");
  252.       ELSE
  253.          WriteString ("    ");
  254.       END; (* IF *)
  255.       WriteName (Argument); WriteString (" : Image;"); WriteLn;
  256.    END; (* FOR *)
  257.    WriteLn;
  258.    WriteString ("END "); WriteName (Output); WriteString ("."); WriteLn;
  259.    CloseDef;
  260.    (* ENDFD *)
  261.    (* FOLD: IMPLEMENTATION *)
  262.    OpenMod;
  263.    WriteString ("IMPLEMENTATION MODULE ");
  264.    WriteName (Output); WriteString (";"); WriteLn;
  265.    WriteLn;
  266.    WriteString ("FROM SYSTEM IMPORT ADR, INLINE;"); WriteLn;
  267. (*** if less than v3.3 ***)
  268.    WriteString ("FROM Heap   IMPORT AllocMem;"); WriteLn;
  269.    WriteString ("FROM Exec   IMPORT CopyMem;"); WriteLn;
  270. (*** endif ***)
  271.    WriteLn;
  272.    FOR num := 1 TO NumArgs() DO
  273.       GetArg (num, Argument, len);
  274.       WriteModProcs (Argument);
  275.    END; (* FOR *)
  276.    WriteLn; WriteString ("BEGIN"); WriteLn;
  277.    FOR num := 1 TO NumArgs() DO
  278.       GetArg (num, Argument, len);
  279.       WriteString ("  Init"); WriteName (Argument); WriteString (";");
  280.       WriteLn;
  281.    END; (* FOR *)
  282.    WriteString ("END "); WriteName (Output); WriteString ("."); WriteLn;
  283.    CloseMod;
  284.    (* ENDFD *)
  285.    WriteLn;
  286.    WriteString ("Done."); WriteLn;
  287. END ImageConvert.
  288.